home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.42 / disklabel / disklabel.p < prev    next >
Text File  |  1995-01-06  |  14KB  |  453 lines
  1. { DiskLabel: schnelles und nettes Bedrucken von 3.5" 70x69 Disketten-
  2.              etiketten. (fontsensitiv...) FREEWARE (siehe DOK)
  3.  
  4.   Version:   1.8
  5.  
  6.   Sprache:   KP/MP3 OS3.1-Includes
  7.  
  8.   Autor:     PackMAN
  9.              Falk Zühlsdorff
  10.              Lindenberg 66
  11.              98693 Ilmenau
  12.  
  13.              email: ai036@rz.tu-ilmenau.de                           }
  14.  
  15. PROGRAM DiskLabel;
  16.  
  17. USES DruckAnwendung,BATTCLOCKLIGHT;
  18. TYPE  TextType          = array[0..28] OF String[14];
  19.       tabfeld           = array[0..19] of Integer;
  20.  
  21. VAR   {----------------------------  Win ----------------------------}
  22.  
  23.       Win               : ^Window;
  24.       NWTags            : array[1..12] OF tagitem;STATIC;
  25.       msg               : ^IntuiMessage;
  26.       akt               : ^Gadget;
  27.       Code              : Byte;STATIC;
  28.  
  29.       {------------------------- HilfsVARs --------------------------}
  30.  
  31.       dummy             : long;STATIC;
  32.       ex,bdummy         : boolean;STATIC;
  33.       tab               : tabfeld;STATIC;
  34.       {----------- die einzelnen Gadgets und ihre HilfsVARs ---------}
  35.  
  36.       ng                : NewGadget;STATIC;
  37.       g                 : array[0..15] OF p_Gadget;STATIC;
  38.       Tags              : array[0..11,0..5] OF TagItem;
  39.  
  40.       StrInfo           : p_StringInfo;
  41.       StrExt            : p_StringExtend;
  42.  
  43.       Tx                : TextType;STATIC;
  44.       CyLa              : array[0..28] of string[3];STATIC;
  45.       cfeld             : array[0..29] OF STR;              {@-Gad}
  46.       STx               : array[0..9] OF string[36];STATIC;
  47.  
  48.       gedr1,gedr2       : boolean;STATIC;
  49.  
  50.       checked           : array[0..1] OF boolean;STATIC;
  51.  
  52.       cycleNr,i         : byte;STATIC;
  53. {---------------------------------------------------------------------}
  54. PROCEDURE InfoLine;
  55. CONST up:=chr(10);
  56. BEGIN
  57.  dummy:=RTReq('Information',
  58.               'Etikettendruck (3.5"/ 70x69 mm)'+up+up+
  59.               'Erstellt in KickPascal 2.12/OS3.1'+up+up+
  60.               'FREEWARE'+up+up+
  61.               '© & P by PackMAN'+up+
  62.               'c/o Falk Zühlsdorff'+up+
  63.               'Lindenberg 66'+up+
  64.               'D-98693 Ilmenau / Thüringen'+up+up+
  65.               'Internet: ai036@rz.tu-ilmenau.de'+up+up+
  66.               'Reqtools.library © by N.François',
  67.               '_OK',1,Win);
  68. END;
  69. {---------------------------------------------------------------------}
  70. PROCEDURE Neu;
  71. BEGIN
  72.  STx[0]:='';
  73.  STx[9]:='';
  74.  FOR i:=2 TO 7 DO STx[i]:='';
  75.  GT_SetGadgetAttrsA(g[0],Win,NIL,^Tags[0,3]);
  76.  FOR i:=2 TO 7 DO GT_SetGadgetAttrsA(g[i],Win,NIL,^Tags[i,3]);
  77.  GT_SetGadgetAttrsA(g[9],Win,NIL,^Tags[9,3]);
  78. END;
  79. {---------------------------------------------------------------------}
  80. PROCEDURE GetStrGaddata;    {my fantastic methode}
  81. BEGIN
  82.   FOR i:=0 TO 9 DO
  83.    BEGIN
  84.     StrInfo:=g[i]^.SpecialInfo;
  85.     STx[i]:=StrInfo^.buffer;
  86.    END;
  87. END;
  88. {--------------------------------------------------------------------}
  89. PROCEDURE Druck;
  90. VAR RTPl,x,j      : long;STATIC;
  91.     prtstr        : string;
  92.  
  93. BEGIN
  94.  RTPl:=RTReq('DiskLabel',
  95.              'Drucken mit NLQ','_JA|_Nein|_STOP',Reqpos_Pointer,Win);
  96.  IF RTPl=0 THEN exit;
  97.  SetPoi(Win);
  98.  GetStrGaddata;
  99.  
  100.  IF NOT OpenPrt('DiskLabel',Win) THEN BEGIN ClearPoi(Win); exit; END;
  101.  
  102.  IF NOT GetPRTPrefs THEN BEGIN ClosePrt(Win); exit;END;
  103.  
  104.  IF NOT PrtCheck('DiskLabel',Win) THEN exit;
  105.  
  106.  CMDLn('');                                    {must set if you`ll set
  107.                                                 the old PrinterPrefs}
  108.  
  109.  PrtCom(aRin,0,0,0,0);                         {init}
  110.  PrtCom(aVERP1,0,0,0,0);                       {1/6 "}
  111.  IF RTPl=1 THEN PrtCom(aDEN2,0,0,0,0)          {NLQ}
  112.            ELSE PrtCom(aDEN1,0,0,0,0);         {Draft}
  113.  PrtCom(aPROP1,0,0,0,0);                       {prop. off}
  114.  
  115.  PrtCom(aSLRM,3,80,0,0);                       {Rand}
  116.  PrtCom(aSHORP4,0,0,0,0);                      {Fine}
  117.  PrtCom(aSUS2,0,0,0,0);                        {Superscript}
  118.  
  119.  prtstr:=STx[0];                               {Kante}
  120.  IF checked[0] AND (STx[9]<>'')
  121.   THEN
  122.    BEGIN
  123.     x:=34-strlen(STx[0]);
  124.     FOR i:=0 TO x DO prtstr:=prtstr+' ';
  125.     prtstr:=prtstr+'Nr: '+STx[9];
  126.    END;
  127.  CMDLn(prtstr);
  128.  CMDLn('');
  129.  
  130.  PrtCom(aSHORP3,0,0,0,0);                      {Fine off}
  131.  PrtCom(aSUS1,0,0,0,0);                        {Superscript off}
  132.  PrtCom(aSHORP6,0,0,0,0);                      {Breit}
  133.  
  134.  x:=TRUNC((13-strlen(STx[1]))/2);              {Verwendung}
  135.  prtstr:='';
  136.  FOR i:=1 TO x DO prtstr:=prtstr+' ';
  137.  prtstr:=prtstr+STx[1];
  138.  CMDLn(prtstr);
  139.  CMDLn('');
  140.  
  141.  PrtCom(aSHORP5,0,0,0,0);                      {Breit off}
  142.  PrtCom(aSHORP0,0,0,0,0);                      {Pica}
  143.  
  144.  FOR i:=2 TO 7 DO
  145.   BEGIN
  146.    prtstr:='';
  147.    IF STx[i]<>''
  148.     THEN
  149.      BEGIN
  150.       x:=TRUNC((25-strlen(STx[i]))/2);         {Zeile 1..6}
  151.       FOR j:=1 TO x DO prtstr:=prtstr+' ';
  152.       prtstr:=prtstr+STx[i];
  153.      END;
  154.    CMDLn(Prtstr);
  155.   END;
  156.  
  157.  CMDLn('');
  158.  prtstr:='';
  159.  
  160.  IF (checked[0]) AND (STx[9]<>'')
  161.   THEN
  162.    BEGIN
  163.     IF checked[1]
  164.      THEN
  165.       BEGIN
  166.        x:=17-strlen(STx[8]);                   {Date}
  167.        prtstr:=STx[8];
  168.        FOR i:=1 TO x DO prtstr:=prtstr+' ';
  169.       END
  170.      ELSE prtstr:='                 ';
  171.     prtstr:=prtstr+'Nr: '+STx[9];              {Nr}
  172.    END
  173.   ELSE
  174.    IF checked[1] THEN prtstr:=STx[8];
  175.  CMDLn(prtstr);
  176.  
  177.  SetPRTPrefs;                                  {old Prefs}
  178.  ClosePrt(Win);
  179. END;
  180.  
  181. {--------------------------------------------------------------------}
  182. PROCEDURE cycle(key:boolean);
  183. BEGIN
  184.  IF key
  185.   THEN
  186.    BEGIN
  187.     IF gedr1 OR gedr2
  188.      THEN
  189.       IF cycleNr=0  THEN cycleNr:=28
  190.                     ELSE DEC(cycleNr)
  191.      ELSE
  192.       IF cycleNr=28 THEN  cycleNr:=0
  193.                     ELSE INC(cycleNr);
  194.     Tags[10]:=TagItem(GTCY_Active,cycleNr);
  195.     GT_SetGadgetAttrsA(g[13],Win,NIL,^Tags[10]);
  196.    END
  197.   ELSE cycleNr:=Code;
  198.  
  199.  STx[1]:=Tx[cycleNr];
  200.  GT_SetGadgetAttrsA(g[1],Win,NIL,^Tags[1,3]);
  201. END;
  202. {--------------------------------------------------------------------}
  203. PROCEDURE check(was:byte);
  204. BEGIN
  205.  IF checked[was] THEN checked[was]:=false {0: Datum, 1: DiskNummer}
  206.                  ELSE checked[was]:=true;
  207. END;
  208. {--------------------------------------------------------------------}
  209. PROCEDURE Ende;
  210. BEGIN
  211.  dummy:=RTReq('DiskLabel',
  212.             'Programm beenden ?','_JA|_Zurück',Reqpos_Pointer,Win);
  213.  IF dummy=1 THEN ex:=true;
  214. END;
  215. {--------------------------------- MAIN -----------------------------}
  216.  
  217. BEGIN
  218.  IF NOT V37
  219.   THEN
  220.    BEGIN
  221.     ErrorReq('Benötigt min. OS2 / needs min. OS2','Yep',NIL);
  222.     exit;
  223.    END;
  224.  
  225.  IF NOT OpenReqtools THEN exit;
  226.  IF NOT Fontsensitiv('DiskLabel',44,25,true) THEN exit;
  227.  
  228.  cycleNr:=0;
  229.  checked[0]:=true;checked[1]:=true;
  230.  
  231.  FOR i:=0 TO 9 DO STx[i]:='';
  232.  ex:=getbattclockL;
  233.  IF battclockdate<>'' THEN STx[8]:=battclockdate;
  234.  
  235.   FOR i:=0 TO 28 DO
  236.    BEGIN
  237.     IF i<10 THEN CyLa[i]:='0'+Intstr(i)
  238.             ELSE CyLa[i]:=Intstr(i);
  239.     cfeld[i]:=^CyLa[i];
  240.    END;
  241.  
  242.   cfeld[29]:=NIL;
  243.                     {MaxChars}                 {StrGads: Width}
  244.   tab:=
  245.    tabfeld(33,13,25,25,25,25,25,25,10,4,28,16,28,28,28,28,28,28,13,7);
  246.  
  247.   { kleines Hilfsfeld um etwas Schreibarbeit zu ersparen, die
  248.     40 Byte belegtem Speicher kann man sich noch leisten... }
  249.  
  250.   FOR i:=0 TO 9 DO
  251.    BEGIN
  252.     Tags[i,0]:=TagItem(GT_Underscore,ord('_'));       {StrGads}
  253.     Tags[i,1]:=TagItem(GTST_MaxChars,tab[i]);
  254.     Tags[i,2]:=TagItem(GA_TabCycle,ord(true));
  255.     Tags[i,3]:=TagItem(GTST_String,long(^STx[i]));
  256.     Tags[i,4].ti_tag:=Tag_Done;
  257.    END;
  258.  
  259.   Tags[10,0]:=TagItem(GTCY_Active,0);                 {CycleGad}
  260.   Tags[10,1]:=TagItem(GTCY_LABELS,long(^cfeld));
  261.   Tags[10,2]:=TagItem(GT_Underscore,ord('_'));
  262.   Tags[10,3].ti_tag:=Tag_Done;
  263.  
  264.   Tags[11,0]:=TagItem(GT_Underscore,ord('_'));
  265.   Tags[11,1]:=TagItem(GTCB_Scaled,ord(true));
  266.   Tags[11,2]:=TagItem(GTCB_Checked,ord(true));
  267.   Tags[11,3].ti_tag:=Tag_Done;                        {Checkboxes}
  268.   Tags[11,4]:=TagItem(GTCB_Checked,ord(false));
  269.   Tags[11,5].ti_tag:=Tag_Done;
  270.  
  271.   Tx:=TextType('_Kante:','_Verwendung:','Zeile _1:','Zeile _2:',
  272.                'Zeile _3:','Zeile _4:','Zeile _5:','Zeile _6:',
  273.                'D_atum:','Di_sk-Nr:','_Info','_Druck','_Neu','_W',
  274.                '_R','_T','','','','','','','','','','','','','');
  275.  
  276.   ng.ng_LeftEdge:=14*xsize;
  277.   ng.ng_Height:=ysize+6;
  278.   ng.ng_TextAttr:=^txattr;
  279.   ng.ng_Flags:=PLACETEXT_LEFT;
  280.   ng.ng_VisualInfo:=vi;
  281.   ng.ng_UserData:=NIL;
  282.  
  283.   FOR i:=0 TO 9 DO
  284.    BEGIN
  285.     ng.ng_GadgetText:=Tx[i];
  286.     ng.ng_GadgetID:=i;
  287.     ng.ng_Width:=xsize*tab[i+10];
  288.     ng.ng_TopEdge:=STF+ysize+(i*2*ysize);
  289.     pgad:=CreateGadgetA(STRING_KIND,pgad,^ng,^Tags[i]);
  290.     g[i]:=pgad;
  291.     StrInfo:=g[i]^.SpecialInfo;
  292.     StrExt:=StrInfo^.Extension;
  293.     StrExt^.ActivePens[1]:=PENs^[HIGHLIGHTTEXTPEN];
  294.    END;
  295.  
  296.   tab:=tabfeld(14,24,34,                  {Button: LeftEdge}
  297.                3*ysize+STF,               {Cycle: TopEdge}
  298.                19*ysize+STF+1,            {CheckBox: TopEdge}
  299.                17*ysize+STF+1,
  300.                7*xsize,                   {Cycle: Width}
  301.                ROUND((ysize+3)*(26/11)),  {CheckBox: Width}
  302.                ROUND((ysize+3)*(26/11)),
  303.                ysize+6,                   {Cycle: Height}
  304.                ysize+3,ysize+3,           {CheckBoxes: Height}
  305.                CYCLE_KIND,
  306.                CHECKBOX_KIND,             {Kind`s}
  307.                CHECKBOX_KIND,
  308.                10,11,11,                  {Tag-Num`s}
  309.                0,0);                      {Shit}
  310.  
  311.   ng.ng_TopEdge:=STF+22*ysize;
  312.   ng.ng_Width:=8*xsize;
  313.   ng.ng_Flags:=PLACETEXT_IN;
  314.  
  315.   FOR i:=10 TO 12 DO
  316.    BEGIN
  317.     ng.ng_LeftEdge:=tab[i-10]*xsize;
  318.     ng.ng_GadgetID:=i;
  319.     ng.ng_GadgetText:=Tx[i];
  320.     pgad:=CreateGadgetA(BUTTON_KIND,pgad,^ng,^Tags[10,2]);
  321.     g[i]:=pgad;
  322.    END;
  323.  
  324.   ng.ng_Flags:=PLACETEXT_RIGHT;
  325.   ng.ng_LeftEdge:=32*xsize;
  326.  
  327.   FOR i:=13 TO 15 DO
  328.    BEGIN
  329.     ng.ng_TopEdge:=tab[i-10];
  330.     ng.ng_GadgetID:=i;
  331.     ng.ng_GadgetText:=Tx[i];
  332.     ng.ng_Width:=tab[i-7];
  333.     ng.ng_Height:=tab[i-4];
  334.     pgad:=CreateGadgetA(tab[i-1],pgad,^ng,^Tags[tab[i+2]]);
  335.     g[i]:=pgad;
  336.    END;
  337.  
  338.   Tx:=TextType('',
  339.                'Programmieren','Source .p','Source .c','Source .asm',
  340.                'Graphik','Public Domain','PURITY','Text / DTP',
  341.                'Utilities','Tools','Anwendung','Kalkulation',
  342.                'Datenbank','Daten','Backup','Demo','Sound',
  343.                'Module','Disk Mag','Game','Adventure',
  344.                'Rollenspiel','Action','Unterhaltung','Simulation',
  345.                'Sportspiel','Amiga','DOSe');
  346.   STx[1]:=Tx[0];
  347.  
  348.    NWTags[1] :=Tagitem(wa_top,0);
  349.    NWTags[2] :=Tagitem(wa_left,0);
  350.    NWTags[3] :=Tagitem(wa_width,44*xsize);
  351.    NWTags[4] :=Tagitem(wa_height,STF+25*ysize);
  352.    NWTags[5] :=Tagitem(wa_activate,ord(true));
  353.    NWTags[6] :=Tagitem(wa_smartrefresh,ord(true));
  354.    NWTags[7] :=Tagitem(wa_rmbtrap,ord(true));
  355.    NWTags[8].ti_tag:=wa_title;
  356.    NWTags[8].ti_data:='DiskLabel 1.8  (19.12.94)';
  357.    NWTags[9]:=Tagitem(wa_Flags,WFLG_CLOSEGADGET+WFLG_DEPTHGADGET+
  358.                                 WFLG_DRAGBAR);
  359.    NWTags[10]:=Tagitem(wa_idcmp,IDCMP_GADGETUP+IDCMP_RAWKEY+
  360.                                 IDCMP_CLOSEWINDOW);
  361.    NWTags[11] :=Tagitem(wa_Gadgets,long(glist));
  362.    NWTags[12].ti_tag:=tag_done;
  363.  
  364.    Win:=openwindowtaglist(nil,^NWTags[1]);
  365.    IF Win<>NIL
  366.     THEN
  367.      BEGIN
  368.       dummy:=setfont(Win^.RPort,font);
  369.  
  370.       ex:=false;
  371.  
  372.       gedr1:=false;
  373.       gedr2:=false;
  374.       REPEAT
  375.        Msg:=Wait_Port(Win^.UserPort);
  376.        Msg:=GT_GetIMsg(Win^.UserPort);
  377.        Code:=Msg^.Code;
  378.        IF Msg<>NIL THEN
  379.         BEGIN
  380.          GT_ReplyIMsg(Msg);
  381.          CASE Msg^.Class OF
  382.  
  383.          IDCMP_CLOSEWINDOW: Ende;
  384.  
  385.          IDCMP_GADGETUP:
  386.           BEGIN
  387.            Akt:=Msg^.IAddress;
  388.            CASE AKT^.GADGETID OF
  389.             0..8: bdummy:=ACTIVATEGADGET(g[AKT^.GADGETID+1],Win,NIL);
  390.               10: InfoLine;
  391.               11: Druck;
  392.               12: Neu;
  393.               13: Cycle(false);
  394.            14,15: Check(Akt^.GadgetID-14);
  395.            ELSE;END;
  396.           END;
  397.          IDCMP_RAWKEY:
  398.           BEGIN
  399.            CASE (Code AND $7f) OF
  400.             $60: IF (Code AND $80)=0
  401.                   THEN gedr1:=true ELSE gedr1:=false;
  402.             $61: IF (Code AND $80)=0
  403.                   THEN gedr2:=true ELSE gedr2:=false;
  404.            ELSE
  405.             CASE Msg^.code OF
  406.                 $27: bdummy:=ACTIVATEGADGET(g[0],Win,NIL); {K Kante}
  407.                 $34: bdummy:=ACTIVATEGADGET(g[1],Win,NIL); {V Verw.}
  408.                 $01: bdummy:=ACTIVATEGADGET(g[2],Win,NIL); {1 Z1}
  409.                 $02: bdummy:=ACTIVATEGADGET(g[3],Win,NIL); {2 Z2}
  410.                 $03: bdummy:=ACTIVATEGADGET(g[4],Win,NIL); {3 Z3}
  411.                 $04: bdummy:=ACTIVATEGADGET(g[5],Win,NIL); {4 Z4}
  412.                 $05: bdummy:=ACTIVATEGADGET(g[6],Win,NIL); {5 Z5}
  413.                 $06: bdummy:=ACTIVATEGADGET(g[7],Win,NIL); {6 Z6}
  414.                 $20: bdummy:=ACTIVATEGADGET(g[8],Win,NIL); {A Datum}
  415.                 $21: bdummy:=ACTIVATEGADGET(g[9],Win,NIL); {S Disk-Nr}
  416.                 $11: Cycle(true);                          { W.}
  417.                 $13,
  418.                 $14: BEGIN                                 {Boxes}
  419.                       Check(Code-$13);
  420.                       IF checked[Code-$13]
  421.                        THEN GT_SetGadgetAttrsA(g[Code-5],Win,NIL,
  422.                                                ^Tags[11,1])
  423.                        ELSE GT_SetGadgetAttrsA(g[Code-5],Win,NIL,
  424.                                                ^Tags[11,4]);
  425.                      END;
  426.                 $17: BEGIN PressButton(Win,g[10]); InfoLine; END;{ I }
  427.                 $36: BEGIN PressButton(Win,g[12]); Neu;      END;{ N }
  428.                 $22: BEGIN PressButton(Win,g[11]); Druck;    END;{ D }
  429.  
  430.                 $10, {Q/E/ESC}
  431.                 $12,
  432.                 $45: Ende;
  433.              ELSE;END;
  434.             END;
  435.           END;
  436.          ELSE;END;
  437.         END;
  438.        UNTIL ex;
  439.  
  440.       CloseWindow(Win);
  441.  
  442.      END
  443.     ELSE dummy:=RTReq('DiskLabel','Kann Oberfläche nicht darstellen.',
  444.                       '_Argh',ReqPos_TopLeftScr,NIL);
  445.  
  446.      FreeGadgets(glist);
  447.      FreeVisualInfo(vi);
  448.      Free_Mem(Long(Pointerptr),sizeof(Pointerfeld));
  449.      CloseSomeLibs;
  450.      IF Utilitybase<>NIL   THEN CloseLibrary(UtilityBase);
  451. END.
  452.  
  453.